home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
pascal
/
code39.zip
/
CODE39.PAS
Wrap
Pascal/Delphi Source File
|
1987-07-09
|
8KB
|
237 lines
program Barcode;
{ by:
Clifford Knight
6 Janebar Circle
Plymouth, MA 02360
617 888 7480
CIS ID# 71106,1153
}
{*** Logmars (Code 39) barcode routines for Epson FX compatible printers ***
NOTE: MIL-STD-1189 (latest revision) has made the OCR-A HRI (Human
Readable Interpretation) of the barcode optional... Therefore, this
routine will produce acceptable LOGMARS labels provided that you
apply a layer of waterproof clear tape... I have done this for
government orders with NO problems.
To implement, first call the procedure InitBarCode, then call
PrintBarCode to actually print the barcode... See the routines
for an explanation of the passed parameters.
The PrintBarCode routine allows you to place the barcode almost
anywhere on your label using 1/216th inch for vertical measure and
1/960th inch for horizontal offsets. Note that the vertical positioning
is specified for "start" and "end", or "before" printing the barcode and
"after" printing the code. The Epson MX and it's kin do not allow
reverse paper motion so this (negative motion) will NOT work with
these printers.
If you specify the 'ht' parameter (in PrintBarCode) as 2 times the
'z' (Size) parameter of the InitBarCode routine, then you'll meet the
Logmars height/length ratio requirement.
By changing the FillBCArray routines assignment statements to fit
other codes (Code 2 of 5, UPC or ???) this routine could do any of
these other sequences.
Enjoy, if you have any questions -or- just to chat, drop a line
(EMail or USPS) to the above addresses...
}
type
Str10 =string[10];
Str80 =string[80];
var
Sequence :Str80;
BCArray :array[0..1000] of byte;
BCArrayLen :integer;
BCGraphLen :integer;
BCKWide :integer;
BCKNarr :integer;
BCPasses :integer;
BCount :integer;
Size :integer;
Density :integer;
BCFile :text;
{***** BarCode Routines *****}
procedure PrintBarCode (ho,vs,ve,fl,ht :integer);
{ ho = horizontal offset in 960th's of an inch
vs = vertical offset (+ or -) at start of barcode
in 216th's of an inch
ve = vertical offset (+ or -) at end of barcode
in 216th's of an inch
fl = barcode field length in 960th's of an inch
ht = number of graphics passes/barcode
(1 pass = 23/216th's inch)
}
var
f,h,i,j,k,l,m :integer;
vc,gch :char;
procedure GraphicTab (n :integer);
begin
write(lst,#27,'L',chr(lo(n)),chr(hi(n)));
while n>0 do begin
write(lst,#0);
n:=pred(n);
end;
end; {GraphicTab}
begin
k:=(fl-BCGraphLen) div 2;
if vs<>0 then begin
if vs>0 then vc:='J'
else vc:='j';
write(lst,#27,vc,chr(abs(vs)));
end;
for h:=1 to ht do begin
for m:=1 to BCPasses do begin
write(lst,#13);
if ho>0 then GraphicTab(ho);
if k>0 then GraphicTab(k);
write(lst,#27,'Y',chr(lo(BCGraphLen)),chr(hi(BCGraphLen)));
f:=1;
for i:=1 to BCArrayLen do begin
f:=swap(f);
gch:=chr(hi(f)*$ff);
for j:=1 to BCArray[i] do write(lst,gch);
end;
write(lst,#13);
end;
if h<ht then write(lst,#27,'J',#23);
end;
if ve<>0 then begin
if ve>0 then vc:='J'
else vc:='j';
write(lst,#27,vc,chr(abs(ve)));
end;
end; {PrintBarCode}
procedure InitBarCode (s :Str80; z,d :integer);
{ s = sequence to be encoded
('*' prefix & suffix will be added)
z = size, number of columns in narrow bar
d = density, number of print head passes
per graphic line
}
procedure FillBCArray (c :char);
var
s :Str10;
e,h,i :integer;
begin
c:=UpCase(c);
case c of
' ' : s:='0110001000';
'$' : s:='0101010000';
'%' : s:='0001010100';
'*' : s:='0100101000';
'+' : s:='0100010100';
'-' : s:='0100001010';
'.' : s:='1100001000';
'/' : s:='0101000100';
'0' : s:='0001101000';
'1' : s:='1001000010';
'2' : s:='0011000010';
'3' : s:='1011000000';
'4' : s:='0001100010';
'5' : s:='1001100000';
'6' : s:='0011100000';
'7' : s:='0001001010';
'8' : s:='1001001000';
'9' : s:='0011001000';
'A' : s:='1000010010';
'B' : s:='0010010010';
'C' : s:='1010010000';
'D' : s:='0000110010';
'E' : s:='1000110000';
'F' : s:='0010110000';
'G' : s:='0000011010';
'H' : s:='1000011000';
'I' : s:='0010011000';
'J' : s:='0000111000';
'K' : s:='1000000110';
'L' : s:='0010000110';
'M' : s:='1010000100';
'N' : s:='0000100110';
'O' : s:='1000100100';
'P' : s:='0010100100';
'Q' : s:='0000001110';
'R' : s:='1000001100';
'S' : s:='0010001100';
'T' : s:='0000101100';
'U' : s:='1100000010';
'V' : s:='0110000010';
'W' : s:='1110000000';
'X' : s:='0100100010';
'Y' : s:='1100100000';
'Z' : s:='0110100000' end;
{case}
for h:=1 to 10 do begin
BCArrayLen:=succ(BCArrayLen);
BCArray[BCArrayLen]:=(ord(s[h])-48)*BCKWide+BCKNarr;
end;
end; {FillBCArray}
procedure ScanSequence (s :Str80);
var
h,i :integer;
begin
BCArrayLen:=0;
s:='*'+s+'*';
for h:=1 to length(s) do begin
FillBCArray(s[h]);
end;
end; {ScanSequence}
procedure GetBCGraphLen;
var
f,j,i :integer;
begin
f:=1;
BCGraphLen:=0;
for i:=1 to BCArrayLen do begin
f:=swap(f);
for j:=1 to (BCArray[i]+lo(f)) do BCGraphLen:=succ(
BCGraphLen);
BCArray[i]:=BCArray[i]+lo(f);
end;
end; {GetBCGraphLen}
begin
BCKWide:=z*2;
BCKNarr:=z;
BCPasses:=d;
ScanSequence(s);
GetBCGraphLen;
end; {InitBarCode}
{NOTE: The following function is used in the demo routine...
It is NOT needed by the barcode routines.
}
function ConstStr (n :integer; c :char) :Str80;
var
s :Str80;
begin
fillchar(s[1],n,c);
s[0]:=chr(n);
ConstStr:=s;
end;
{*** sample test routine ***}
begin
repeat
clrscr;
write('Enter size (1..5, -99 to end...): ');
readln(Size);
if Size<>-99 then begin
write('Enter density (1..3, -99 to end...): ');
readln(Density);
if Density<>-99 then begin
repeat
write('Enter sequence (-99 to end...): ');
readln(Sequence);
if (Sequence<>'-99') then begin
writeln('printing: ',Sequence,#10);
InitBarCode(Sequence,Size,Density);
PrintBarCode(10,0,0,960,Size*2);
write(lst,#13,#10,#27,'E');
writeln(lst,ConstStr(40-trunc(length(Sequence)/2),' '),
Sequence);
writeln(lst,ConstStr(6,#10));
end;
until (Sequence='-99') or keypressed;
end;
end;
until (Size=-99) or (Density=-99);
end.
Download complete. Turn off Capture File.
Download another file (Y/N)?